Demo: Updated LB Contact Manager
by Ken Lewis Sr. Gordon@gsweet.fsnet.co.uk
Ken Lewis Sr.'s Updated Contact Manager
[Editor's Commnet: For Newsletter issue 121, programmer Ken Lewis Sr. has provided an updated version of Contact3.bas, the contact management program that comes with Liberty BASIC. Ken's 1Contact.bas features a number of nice enhancements, all of which are identified by Ken in the comment section of his sourcecode. If you would like to try this program, you may copy the code provided below, or look for the file 1Contact.bas in Newsletter 121's zip archive. (Requires LB4.) Thanks, Ken!]
'This program was included with LB as Contact3.bas
'I made some changes to suit my own needs
'I added a group of buttons to paste info that was
'copied from a database to the chosen textbox
'I also added a listbox to find and show duplicates
'so I could replace them with a new record
'I didn't want either control always showing and
'I didn't want to lose any other controls
'in order to show the new controls so I used
'SetWindowPos to show and hide the controls
'I thought if the paste control was showing it
'should always be next to the textboxes
'Or if the paste control was hidden and the listbox
'was showing it should be next to the textboxes
'so I didn't have to show the paste control in
'order to show the duplicates control
'I disabled user resizing of the window except
'minimize and restore
'I used the stylebits command to gray out the
'maximize box in the title bar so the user
'would know it was disabled
'I have removed all code not essential to the demo
global hMain 'make window handle available to event handler subs
nomainwin
dim name$(500), stage$(7), dup$(250)
stage$(0) = "All"
stage$(1) = "Initial Phone Call"
stage$(2) = "Opening Mailer"
stage$(3) = "Follow Up Call"
stage$(4) = "Meeting?"
stage$(5) = "Next Phone Call"
paste=0
dupo=0
dupNum=0
pos=0
gosub [loadNames]
gosub [openMainWindow]
hMain=hwnd(#main)
hPaste=hwnd(#main.paste)
hfind=hwnd(#main.find)
call noResize hMain
print #main.contacts, "setfocus"
[inputLoop]
wait
[openMainWindow]
stylebits #main.memo, _WS_VSCROLL or _ES_MULTILINE,_ES_AUTOHSCROLL,0,0
stylebits #main, 0,_WS_MAXIMIZEBOX,0,0 'disable max button on title bar
WindowWidth = 495 '595 695 795
WindowHeight = 380
UpperLeftX=1
UpperLeftY=DisplayHeight-(WindowHeight+30)
statictext #main, "Contacts", 10, 10, 60, 20
listbox #main.contacts, name$(, [editName], 10, 35, 160, 120
statictext #main, "Filter Contacts", 10, 170, 160, 20
combobox #main.filter, stage$(, [loadNamesFiltered], 10, 190, 160, 120
statictext #main, "Business", 200, 10, 50, 20
textbox #main.name, 255, 10, 225, 25
statictext #main, "Contact", 200, 40, 50, 20
textbox #main.contact, 255, 40, 225, 25
statictext #main, "Address", 200, 70, 50, 20
textbox #main.addr, 255, 70, 225, 25
statictext #main, "City", 200, 100, 50, 20
textbox #main.city, 255, 100, 225, 25
statictext #main, "State", 200, 130, 50, 20
textbox #main.state, 255, 130, 40, 25
statictext #main, "Zip", 330, 130, 30, 20
textbox #main.zip, 370, 130, 108, 25
statictext #main, "Phone #", 200, 160, 50, 20
textbox #main.phone, 255, 160, 225, 25
statictext #main, "Phone 2", 200, 190, 50, 20
textbox #main.phone2, 255, 190, 225, 25
statictext #main, "Stage", 200, 220, 50, 20
combobox #main.stage, stage$(, [inputLoop], 255, 220, 225, 110
statictext #main, "Memo", 200, 250, 50, 20
textbox #main.memo, 255, 250, 225, 60
button #main.new, " &New ", [addName], UL, 10, 320
button #main.paste "Show Paste Control", [paste], UL, 83, 320
button #main.find "Find Duplicates", [findDuplicates], UL, 252, 320
button #main, " &Accept ", [acceptEntry], UL, 398, 320
button #main.nameb, "Business", paste, UL 495, 10, 80, 25
button #main.contactb, "Contact", paste, UL 495, 40, 80, 25
button #main.addrb, "Address", paste, UL 495, 70, 80, 25
button #main.cityb, "City", paste, UL 495, 100, 80, 25
button #main.stateb, "State", paste, UL 495, 130, 35, 25
button #main.zipb, "Zip", paste, UL 540, 130, 35, 25
button #main.phoneb, "Phone", paste, UL 495, 160, 80, 25
button #main.phone2b, "Phone2", paste, UL 495, 190, 80, 25
button #main.memob, "Memo", paste, UL 495, 250, 80, 25
listbox #main.namel, dup$(, [doNuttin], 590, 10, 190, 335
open "Liberty Contact Manager" for window as #main
print #main, "trapclose [quit]"
print #main.filter, "select All";
print #main.contacts, "singleclickselect"
return
[loadNames]
return
[loadNamesFiltered]
goto [inputLoop]
[initializeNames]
return
[addName]
goto [inputLoop]
[getContactRecord]
return
[editName]
goto [inputLoop]
[acceptEntry]
gosub [saveContactRecord]
addName = 0
goto [loadNamesFiltered]
[saveContactRecord]
return
[paste] 'change button text to show or hide control
paste=abs(paste-1) 'paste control show or hide flag
if paste=1 then
text$="Hide Paste Control" 'new text for button
calldll #user32, "SetWindowTextA",_ 'API call to change button text
hPaste as ulong,_ 'handle to button to be changed
text$ as ptr,_ 'pointer to new text
ret as void 'I don't usually check this return value
else
text$="Show Paste Control"
calldll #user32, "SetWindowTextA",_
hPaste as ulong,_
text$ as ptr,_
ret as void
end if
gosub [relocate]
call resizeWindow "paste", pos, paste, dupo
wait
[findDuplicates]
dupo=abs(dupo-1) 'duplicates control show or hide flag
if dupo=1 then
text$="Hide Duplicates"
calldll #user32, "SetWindowTextA",_
hfind as ulong,_
text$ as ptr,_
ret as void
gosub [relocate]
call resizeWindow "dupo", pos, paste, dupo
for i1=1 to contactCount-1 'here I find my duplicates
for i2=i1+1 to contactCount 'I make sure that I don't
if name$(i1)=name$(i2) then 'check a record against itself
dupNum=dupNum+1
dup$(dupNum)=name$(i1)+" @ "+str$(i1)+" & "+str$(i2)
end if
next i2
next i1
print #main.namel, "reload" 'reload the listbox
else
text$="Find Duplicates"
calldll #user32, "SetWindowTextA",_
hfind as ulong,_
text$ as ptr,_
ret as void
for clearlist=1 to dupNum 'clear the listbox array or else
dup$(clearlist)="" 'I list the same duplicates again
next clearlist 'along with any new ones if I run
print #main.namel, "reload" 'the control more than once
gosub [relocate]
call resizeWindow "dupo", pos, paste, dupo
end if
wait
[doNuttin]
wait
[relocate]
if pos=0 then 'flag for paste control current location
if paste=0 then 'if paste control is hidden move duplicates
if dupo=1 then 'control next to textboxes
print #main.nameb, "!locate 700 10 80 25"
print #main.contactb, "!locate 700 40 80 25"
print #main.addrb, "!locate 700 70 80 25"
print #main.cityb, "!locate 700 100 80 25"
print #main.stateb, "!locate 700 130 35 25"
print #main.zipb, "!locate 745 130 35 25"
print #main.phoneb, "!locate 700 160 80 25"
print #main.phone2b, "!locate 700 190 80 25"
print #main.memob, "!locate 700 250 80 25"
print #main.namel, "locate 495 10 190 335"
pos=abs(pos-1)
end if
end if
else
if paste=1 then 'else move paste control next to textboxes
print #main.nameb, "!locate 495 10 80 25"
print #main.contactb, "!locate 495 40 80 25"
print #main.addrb, "!locate 495 70 80 25"
print #main.cityb, "!locate 495 100 80 25"
print #main.stateb, "!locate 495 130 35 25"
print #main.zipb, "!locate 540 130 35 25"
print #main.phoneb, "!locate 495 160 80 25"
print #main.phone2b, "!locate 495 190 80 25"
print #main.memob, "!locate 495 250 80 25"
print #main.namel, "locate 590 10 190 335"
pos=abs(pos-1)
end if
end if
return
[quit]
close #main
end
sub paste handle$ 'this is where we actually paste to the textbox
'the buttons LB handle is the same as its corresponding textbox with a b added to the end
'strip away the b and I have the textboxes LB handle to paste to
handle$=left$(handle$,len(handle$)-1)
CallDll #user32, "OpenClipboard",_ 'API call to gain access to the clipboard
hMain as long,_ 'handle to the window requesting access
r as boolean 'return value (success is non zero)
calldll #user32, "GetClipboardData",_ 'API call to get data from clipboard
_CF_TEXT as long,_ 'value denoting format of data expected
txtHandle as ulong 'handle to the memory containing the data
if txtHandle<>0 then
print #handle$, ""
print #handle$, winstring(txtHandle)
end if
CallDll #user32, "CloseClipboard", r as boolean 'API call to release clipboard
end sub
sub resizeWindow caller$, order, paster, dupor 'sub to change window size
if paster=1 then 'if paste is to show and
if dupor=1 then 'if duplicate is to show
xExtent=795 'window width
else
xExtent=595 'else if duplicate is hidden use this width
end if
else
if dupor=1 then 'else if paste is hidden and duplicate is showing
xExtent=695 'use this window width
else
xExtent=495 'else if both are hidden use this width
end if
end if
callDll #user32, "SetWindowPos",_ 'very useful API call can do many things
hMain as ulong,_ 'handle to window to be acted upon
0 as long,_ 'z-order placement (0=top of z-order)
0 as long,_ 'upper left corner x position ignored because of flag
0 as long,_ 'upper left corner y position ignored because of flag
xExtent as long,_ 'window width
380 as long,_ 'window height
_SWP_NOMOVE as ulong,_ 'flag to denote use current upper left x and y
result as void
end sub
sub noResize h 'here we remove system menu sizing options except minimize and restore
calldll #user32, "GetSystemMenu", _
h as word, 0 as word, hmenu as word
sysmenu.Restore=GetMenuItemID(hmenu,0)
sysmenu.Move=GetMenuItemID(hmenu,1)
sysmenu.Size=GetMenuItemID(hmenu,2)
sysmenu.Minimize=GetMenuItemID(hmenu,3)
sysmenu.Maximize=GetMenuItemID(hmenu,4)
sysmenu.sep1=GetMenuItemID(hmenu,5)
sysmenu.Close=GetMenuItemID(hmenu,6)
sysmenu.KillApps=GetMenuItemID(hmenu,7)
' calldll #user32, "DeleteMenu", hmenu as word, sysmenu.Move as word, _
' _MF_BYCOMMAND as word, re as word
' calldll #user32, "DeleteMenu", hmenu as word, sysmenu.Minimize as word, _
' _MF_BYCOMMAND as word, re as word
calldll #user32, "DeleteMenu", hmenu as word, sysmenu.Maximize as word, _
_MF_BYCOMMAND as word, re as word
calldll #user32, "DeleteMenu", hmenu as word, sysmenu.Size as word, _
_MF_BYCOMMAND as word, re as word
end sub
function GetMenuItemID(hmenu,index)
calldll #user32, "GetMenuItemID", hmenu as word, index as word, GetMenuItemID as word
end function